home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Franz PD / Franz PD Disk #113 (1991-01)(Amiga User Group Deutschland e.V.).zip / Franz PD Disk #113 (1991-01)(Amiga User Group Deutschland e.V.).adf / Rätsel / Irre (.txt) < prev    next >
AmigaBASIC Source Code  |  1989-07-03  |  7KB  |  309 lines
  1.  
  2.  
  3.  
  4.  
  5. acbmname$="Baugrund"
  6. REM IF FRE(1)<30000& THEN CLEAR,,30000&                         
  7. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  8. DECLARE FUNCTION xOpen&  LIBRARY
  9. DECLARE FUNCTION xRead&  LIBRARY
  10. DECLARE FUNCTION xWrite& LIBRARY
  11. DECLARE FUNCTION AllocMem&() LIBRARY
  12. LIBRARY "dos.library"
  13. LIBRARY "exec.library"
  14. LIBRARY "graphics.library"
  15.  
  16. loadError$ = ""
  17. GOSUB LoadACBM
  18. IF loadError$ <> "" THEN GOTO Mcleanup
  19.  IF foundCCRT AND ccrtDir% THEN
  20.    FOR kk = 0 TO nColors% -1
  21.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  22.       cTabWork%(kk) = cTabSave%(kk)
  23.    NEXT
  24.     FOR kk = 0 TO 80
  25.       IF ccrtDir% = 1 THEN
  26.          GOSUB Fcycle
  27.       ELSE   
  28.          GOSUB Bcycle
  29.       END IF
  30.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  31.       FOR de1 = 0 TO ccrtSecs& * 3000
  32.          FOR de2 = 0 TO ccrtMics& / 500
  33.          NEXT
  34.       NEXT
  35.    NEXT
  36.     CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  37. END IF
  38.  
  39. Mcleanup:
  40. GOTO spielanfang: 
  41.  
  42. Mcleanup2:
  43. REM LIBRARY CLOSE
  44. IF loadError$ <> "" THEN PRINT loadError$
  45. END
  46. cTemp% = cTabWork%(ccrtEnd%)
  47. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  48.    cTabWork%(jj+1) = cTabWork%(jj)
  49. NEXT
  50. cTabWork%(ccrtStart%) = cTemp%
  51. RETURN
  52.  
  53. Fcycle:  '" Farbzyklus vorwärts (forward)
  54. cTemp% = cTabWork%(ccrtStart%)
  55. FOR jj = ccrtStart%+1 TO ccrtEnd%
  56.    cTabWork%(jj-1) = cTabWork%(jj)
  57. NEXT
  58. cTabWork%(ccrtEnd%) = cTemp%
  59. RETURN
  60.  
  61.  
  62. LoadACBM:
  63. '" - Folgende Variablen müssen 
  64. '" - initialisiert sein:
  65. REM -    ACBMname$ (ACBM-Dateiname)
  66.  
  67. REM - Variablen initialisieren
  68. f$ = acbmname$
  69. fHandle& = 0
  70. mybuf& = 0
  71. foundBMHD = 0
  72. foundCMAP = 0
  73. foundCAMG = 0
  74. foundCCRT = 0
  75. foundABIT = 0
  76.  
  77. REM - aus include/libraries/dos.h
  78. REM - MODE_NEWFILE = 1006 
  79. REM - MODE_OLDFILE = 1005
  80.  
  81. filename$ = f$ + CHR$(0)
  82. fHandle& = xOpen&(SADD(filename$),1005)
  83. IF fHandle& = 0 THEN
  84.    loadError$ = "Eingabedatei nicht gefunden/lesbar."
  85.    GOTO Lcleanup
  86. END IF
  87.  
  88.  
  89. REM - Pufferspeicherplatz reservieren
  90. ClearPublic& = 65537
  91. mybufsize& = 360
  92. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  93. IF mybuf& = 0 THEN
  94.    loadError$ = "Pufferspeicherplatz nicht verfügbar."
  95.    GOTO Lcleanup
  96. END IF
  97.  
  98. inbuf& = mybuf&
  99. cbuf& = mybuf& + 120
  100. ctab& = mybuf& + 240
  101.  
  102.  
  103. REM - Eingabe sollte lauten  FORMnnnnACBM
  104. rLen& = xRead&(fHandle&,inbuf&,12)
  105. tt$ = ""
  106. FOR kk = 8 TO 11
  107.    tt% = PEEK(inbuf& + kk)
  108.    tt$ = tt$ + CHR$(tt%)
  109. NEXT
  110.  
  111. IF tt$ <> "ACBM" THEN 
  112.    loadError$ = "Keine ACBM-Grafikdatei."
  113.    GOTO Lcleanup
  114. END IF
  115.  
  116. REM - ACBM-Datei Chunk-weise lesen
  117.  
  118. ChunkLoop:
  119. REM - Chunk-Name/Länge ermitteln
  120.  rLen& = xRead&(fHandle&,inbuf&,8)
  121.  icLen& = PEEKL(inbuf& + 4)
  122.  tt$ = ""
  123.  FOR kk = 0 TO 3
  124.     tt% = PEEK(inbuf& + kk)
  125.     tt$ = tt$ + CHR$(tt%)
  126.  NEXT   
  127.     
  128. IF tt$ = "BMHD" THEN  'BitMap-Header 
  129.    foundBMHD = 1
  130.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  131.    iWidth%  = PEEKW(inbuf&)
  132.    iHeight% = PEEKW(inbuf& + 2)
  133.    iDepth%  = PEEK(inbuf& + 8)  
  134.    iCompr%  = PEEK(inbuf& + 10)
  135.    scrWidth%  = PEEKW(inbuf& + 16)
  136.    scrHeight% = PEEKW(inbuf& + 18)
  137.  
  138.    iRowBytes% = iWidth% /8
  139.    scrRowBytes% = scrWidth% / 8
  140.    nColors%  = 2^(iDepth%)
  141.  
  142.    '" - Genug Platz für Videospeicher ?
  143.    AvailRam& = FRE(-1)
  144.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  145.    IF AvailRam& < NeededRam& THEN
  146.       loadError$ = "Speicherplatz reicht nicht aus."
  147.       GOTO Lcleanup
  148.    END IF
  149.  
  150.    kk = 1
  151.    IF scrWidth% > 320 THEN kk = kk + 1
  152.    IF scrHeight% > 200  THEN kk = kk + 2
  153.    SCREEN 2,scrWidth%,scrHeight%,5,1
  154.    WINDOW 2,"",,0,2
  155.    CALL freesprite (0)
  156.    REM - Adressen von Screen-Structures ermitteln
  157.    GOSUB GetScrAddrs
  158.  
  159.    REM - Schirm während Ladevorgang dunkel
  160.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  161.  
  162.  
  163. ELSEIF tt$ = "CMAP" THEN  'Farbpalette
  164.    foundCMAP = 1
  165.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  166.  
  167.    REM - Farbpalette aufbauen
  168.    FOR kk = 0 TO nColors% - 1
  169.       red% = PEEK(cbuf&+(kk*3))
  170.       gre% = PEEK(cbuf&+(kk*3)+1)
  171.       blu% = PEEK(cbuf&+(kk*3)+2)
  172.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  173.       POKEW(ctab&+(2*kk)),regTemp%
  174.    NEXT
  175.  
  176.  
  177. ELSEIF tt$ = "CAMG" THEN 'Amiga ViewPort Modes
  178.    foundCAMG = 1
  179.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  180.    camgModes& = PEEKL(inbuf&)
  181.  
  182.  
  183. ELSEIF tt$ = "CCRT" THEN 'Graphicraft-Farbzyklus-Daten
  184.    foundCCRT = 1
  185.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  186.    ccrtDir%    = PEEKW(inbuf&)
  187.    ccrtStart%  = PEEK(inbuf& + 2)
  188.    ccrtEnd%    = PEEK(inbuf& + 3)
  189.    ccrtSecs&   = PEEKL(inbuf& + 4)
  190.    ccrtMics&   = PEEKL(inbuf& + 8)
  191.  
  192.  
  193. ELSEIF tt$ = "ABIT" THEN  'Contiguous BitMap 
  194.    foundABIT = 1
  195.  
  196.    '" - Hier werden nur volle BitMaps verarbeitet, keine 
  197.    '" - Ausschnitte wie z.B. Pinsel (Brushes).
  198.    '" - Sehr schnell, liest ganze BitPlanes.
  199.    plSize& = (scrWidth%/8) * scrHeight%
  200.    FOR pp = 0 TO iDepth% -1
  201.       rLen& = xRead&(fHandle&,bPlane&(pp),plSize&)   
  202.    NEXT
  203.  
  204.  
  205. ELSE 
  206.    REM - unbekannten Chunk-Typ lesen  
  207.    FOR kk = 1 TO icLen&
  208.       rLen& = xRead&(fHandle&,inbuf&,1)
  209.    NEXT
  210.    '" - Wenn Länge ungerade, noch 1 Byte lesen
  211.    IF (icLen& OR 1) = icLen& THEN 
  212.       rLen& = xRead&(fHandle&,inbuf&,1)
  213.    END IF
  214.       
  215. END IF
  216.  
  217.  
  218. REM - Fertig, wenn alle Chunks gelesen
  219. IF foundBMHD AND foundCMAP AND foundABIT THEN
  220.    GOTO GoodLoad
  221. END IF
  222.  
  223. REM - Lesen ok, nächsten Chunk lesen
  224. IF rLen& > 0 THEN GOTO ChunkLoop
  225.  
  226. IF rLen& < 0 THEN  ' Lesefehler
  227.    loadError$ = "Lesefehler."
  228.    GOTO Lcleanup
  229. END IF   
  230.  
  231. REM - rLen& = 0  heißt EOF (Dateiende)
  232. IF (foundBMHD=0) OR (foundABIT=0) OR (foundCMAP=0) THEN
  233.    loadError$ = "Wichtige IFF-Chunks nicht gefunden."
  234.    GOTO Lcleanup
  235. END IF
  236.  
  237.  
  238. GoodLoad:
  239. loadError$ =""
  240.  
  241. REM  Farbpalette
  242. IF foundCMAP THEN 
  243.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  244. END IF
  245.  
  246. Lcleanup:
  247. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  248. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  249.  
  250. RETURN
  251.  
  252.  
  253. GetScrAddrs:
  254. REM - Adressen von Screen-Structures ermitteln
  255.    sWindow&   = WINDOW(7)
  256.    sScreen&   = PEEKL(sWindow& + 46)
  257.    sViewPort& = sScreen& + 44
  258.    sRastPort& = sScreen& + 84
  259.    sColorMap& = PEEKL(sViewPort& + 4)
  260.    colorTab&  = PEEKL(sColorMap& + 4)
  261.    sBitMap&   = PEEKL(sRastPort& + 4)
  262.  
  263.    REM - Screen-Parameter ermitteln
  264.    scrWidth%  = PEEKW(sScreen& + 12)
  265.    scrHeight% = PEEKW(sScreen& + 14)
  266.    scrDepth%  = PEEK(sBitMap& + 5)
  267.    nColors%   = 2^scrDepth%
  268.  
  269.    REM - Adressen der BitPlanes ermitteln
  270.    FOR kk = 0 TO scrDepth% - 1
  271.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  272.    NEXT
  273. RETURN
  274.  
  275. spielanfang:
  276.     LINE (270,235)-(305,255),7,bf
  277.   LOCATE 31,35:COLOR 5,7:PRINT "ENDE"
  278.  
  279.  anfang:
  280.      ON MOUSE GOSUB mausdruck
  281.      MOUSE ON
  282.      WHILE 1 : WEND
  283.  mausdruck:
  284.      druck=MOUSE(0)
  285.      x=MOUSE(3) : y=MOUSE(4)
  286.    IF x>280 AND x<305 AND y>236 AND y<254 THEN GOTO ende
  287.    IF x>120 AND x<210 AND y>235 AND y<255 THEN GOTO aufloesung
  288.    GOTO anfang
  289. aufloesung:   
  290.    LINE (0,141)-(330,230),12,bf
  291.   LOCATE 20,3:COLOR 4,12: PRINT "AUFLÖSUNG:"
  292.   LOCATE 22,3:PRINT "255m + 300m = 555m
  293.   LOCATE 24,3:PRINT "Ein Strich läßt sich schwer verkaufen."
  294.   GOTO anfang
  295.   END
  296. ende:
  297.  WINDOW CLOSE 1
  298.  SCREEN CLOSE 1
  299.  SYSTEM
  300.  END
  301.    
  302. '**********************************************************************
  303. ' Detlef Kornatz
  304. ' Feuerbachstraße 6
  305. ' D-4300 ESSEN 1
  306. '***********************************************************************
  307.  
  308.  
  309.